home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
vscode23.arc
/
VSCODE23.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-03-01
|
10KB
|
336 lines
{***************************************************************}
{* *}
{* C O D E R 2.3 *}
{* *}
{* reserved files encoder *}
{* (English version) *}
{* --------------------------------------------------------- *}
{* for informations please refer to: *}
{* *}
{* LUCA MANUNTA *}
{* Via Ignazio Ciampi 14 *}
{* 00162 ROMA *}
{* ITALY tel.06/8600384 *}
{* *}
{* --------------------------------------------------------- *}
{* copyright by MANUSOFT '89 *}
{***************************************************************}
type
daco=char;
var
error,pw,key,line,x,y,a,b,c,d,ncod,lun:integer;
codif,concordi,cond1,cond2:boolean;
flg1,flg2,flg3:boolean;
cripto:string[5];
answ3,chiave,dom:string[20];
answ1,answ2:string[12];
answ,codato,contr,dacod:char;
destfil,nomefil:file of daco;
OVERLAY PROCEDURE help; {-------------------------------------------------------}
PROCEDURE screen;
begin
clrscr;
for a:=1 to 80 do write('*');
for a:=1 to 80 do
begin
gotoxy(a,24);write('*');
end;
gotoxy(10,25);write('<ESC> back to Main menu *manusoft ''89*');
textbackground(7);textcolor(0);
gotoxy(30,5);
write(' C O D E R 2.3 ');
textbackground(0);textcolor(15);
end;
begin
screen;
gotoxy(2,7);writeln(' The program "CODER", in his brand new version 2.3, allows you to protect');
writeln(' your reserved files, of any kind and length. This protection can be reached ');
writeln(' through an impenetrable algoritm of encryption which works on the base of a ');
writeln(' key directly given by the user. It is therefore plain that wether this key is');
writeln(' not known it isn''t also possible to decrypt the coded file.');
writeln;writeln;
writeln;write(' The program is divided into three main sections:');
writeln;
write(' Two of them are strictly operative, the third (this shown) is overlayed not to occupy uselessly memory');
write(' space. ');
writeln;writeln;
write('(press any key to have more specific informations)');
read(kbd,answ);
if(ord(answ)=27) then exit;
screen;
gotoxy(5,7);writeln('SEZ.CRITTOGRAFAZIONE:');
writeln(' The prompt will ask you to input the name of the file to be encrypted and the ');
writeln(' encryption key to be used. In output the program will give back a file with ');
writeln(' same name of source file but having .COD extension. This parameter cannot be');
writeln(' modified by the user. Source file will be automatically deleted.');
writeln;writeln;
writeln('SEZ. DECRITTOGRAFAZIONE:');
writeln(' The prompt will ask you to input the name of the file to be uncrypted and the ');
writeln(' decryptation key used for encryption of that file - always rember the specific');
writeln(' encryption key used for each file as there will be no other way to restore the');
writeln(' file in his original form and you will loose all data.');
writeln(' In output the program will give back the original file, with same name but ');
writeln(' .DOC extension (this means that when you decrypt any executable file you ');
writeln(' will have to change "manually" its extension in .COM or .EXE to execute it');
writeln(' from MS-DOS. The coded file will be automatically deleted.');
repeat until keypressed;
end;
PROCEDURE schermo; {------------------------------------------------------}
begin
clrscr;
for a:=1 to 80 do write('*');
for a:=1 to 80 do
begin
gotoxy(a,24);write('*');
end;
for y:=1 to 23 do
begin
x:=1;
gotoxy(x,y);write('*');
x:=80;
gotoxy(x,y);write('*');
end;
gotoxy(10,25);write('<ESC> to exit *manusoft ''89*');
end;
PROCEDURE leggidati; {------------------------------------------------------}
begin
gotoxy(25,13);write('File name to be ',dom);
read(kbd,contr);
a:=ord(contr);
if (a=27) then
begin
flg3:=true;
exit;
end;
gotoxy(30,16);write(contr);read(answ1);
answ1:=contr+answ1;
gotoxy(25,13);write(' ');
gotoxy(25,16);write(' ');
gotoxy(25,13);write('Input encryption key...');
gotoxy(30,16);read(answ3);
end;
PROCEDURE errorcheck; {------------------------------------------------------}
begin
error:=IOresult;
while (error<>0) do
begin
if (error=1) then
begin
clrscr;
writeln('ERROR OCCURRED:');
writeln('The file to be encrypted (',answ1,') doesn''t exists at specified address');
writeln;writeln('press any key');
repeat
until keypressed;
flg1:=true;
end;
if (error=241) then
begin
clrscr;
writeln('ERROR OCCURRED:');
writeln('Destination disk is full.');
writeln('Please change disk and press any key or <ESC> to exit');
read(kbd,answ);
if (answ=chr(27)) then flg2:=true;
flg1:=true;
end;
if (error<>1) and (error<>241) then
begin
clrscr;
writeln('ERROR OCCURRED:');
writeln('Error n.',error,' verified during encryption file process ');
writeln('Please verify program or call a technic.');
flg2:=true;
end;
error:=0;
end;
end;
PROCEDURE destcheck; {------------------------------------------------------}
begin
{$i-} reset(destfil) {$i+};
if (IOresult=0) then
begin
clrscr;
writeln('WARNING : file already exists');
writeln(' Overwrite it? (y/n) ');
read(kbd,answ);
case answ of
'Y','y':exit;
'n','N':flg1:=true;
else destcheck;
end;
end;
end;
PROCEDURE apertura; {------------------------------------------------------}
begin
assign(nomefil,answ1);
assign(destfil,answ2);
chiave:=answ3;
lun:=length(chiave);
a:=0;
b:=0;
c:=0;
flg1:=false;
flg2:=false;
cripto:='';
{$i-} reset(nomefil) {$i+};
errorcheck;
if flg1 or flg2 then exit;
destcheck;
if flg1 or flg2 then exit;
rewrite(destfil);
clrscr;
end;
PROCEDURE working; {------------------------------------------------------}
begin
case d of
50: begin
gotoxy(30,12);
write('O O O O O O');
end;
100: begin
gotoxy(30,12);
write(' O O O O O ');
end;
150: begin
d:=0;
gotoxy(30,12);
write(' O O O O O ');
end;
end;
end;
PROCEDURE ciclolavoro; {---------------------------------------------------}
begin
gotoxy(35,10);
textbackground(7);textcolor(0);
write('WORKING');
textbackground(0);textcolor(15);
for a:=1 to filesize(nomefil) do
begin
d:=d+1;
read(nomefil,dacod);
b:=0;
pw:=ord(dacod);
c:=c+1;if (c>lun) then c:=1;
key:=ord(copy(chiave,c,1));
working;
if codif then
begin
ncod:=pw+sqr(key);
if (ncod>255) then ncod:=ncod-256;
end;
if not codif then
begin
ncod:=pw-sqr(key);
if (ncod<0) then ncod:=ncod+256;
end;
codato:=chr(ncod);
write(destfil,codato);
end;
close(nomefil);
close(destfil);
erase(nomefil);
clrscr;
gotoxy(20,10);writeln('Successfull encryption, destination file: ',answ2);
writeln;writeln('(Press any key)');
repeat until keypressed;
end;
PROCEDURE critto; {-----------------------------------------------------}
begin
schermo;
gotoxy(25,5);write('ENCRYPTION :');
dom:='encrypt?';
leggidati;
if flg3 then exit;
answ2:=copy(answ1,1,pos('.',answ1))+'cod';
apertura;
if flg1 or flg2 then exit;
codif:=true;
ciclolavoro;
end;
PROCEDURE decritto; {______________________________________________________}
begin
schermo;
gotoxy(25,5);write('UNCRYPTION :');
dom:='uncrypt?';
leggidati;
if flg3 then exit;
answ2:=copy(answ1,1,pos('.',answ1))+'doc';
apertura;
if flg1 or flg2 then exit;
codif:=false;
ciclolavoro;
end;
PROCEDURE mainopz; {--------------------------------------------------------}
begin
flg3:=false;
schermo;
textbackground(7);textcolor(0);
gotoxy(32,5);
write(' C O D E R 2.3 ');
textbackground(0);textcolor(15);
gotoxy(35,6);write('---------');
gotoxy(25,7);write('Reserved files encryption');
gotoxy(25,8);write('--------------------------------');
gotoxy(27,12);write('1) Encryption');
gotoxy(27,14);write('2) Uncryption');
gotoxy(27,16);write('3) Help');
read(kbd,answ);
if (ord(answ)=27) then exit;
case answ of
'1': critto;
'2': decritto;
'3': help;
end;
if flg2 then exit;
mainopz;
end;
{-------------- HERE BEGINS PROGRAM MAIN LOOP -----------------}
begin
flg1:=false;
flg2:=false;
error:=0;
mainopz;
clrscr;
gotoxy(20,10);
exit;
end.